home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / SCHEME / GNU / SCM4E1 / !Scm / slib / ratize < prev    next >
Text File  |  1992-02-02  |  1KB  |  45 lines
  1. ;;;; Rationalize
  2.  
  3. ;;; The procedure rationalize is interesting because most programming
  4. ;;; languages do not provide anything analogous to it.  For
  5. ;;; simplicity, we present an algorithm which computes the correct
  6. ;;; result for exact arguments (provided the implementation supports
  7. ;;; exact rational numbers of unlimited precision), and produces a
  8. ;;; reasonable answer for inexact arguments when inexact arithmetic is
  9. ;;; implemented using floating-point.  We thank Alan Bawden for
  10. ;;; contributing this algorithm.
  11.  
  12. (define (rationalize x e)
  13.   (simplest-rational (- x e) (+ x e)))
  14.  
  15. (define (simplest-rational x y)
  16.   (define (simplest-rational-internal x y)
  17.     ;; assumes 0 < X < Y
  18.     (let ((fx (floor x))
  19.       (fy (floor y)))
  20.       (cond ((not (< fx x))
  21.          fx)
  22.         ((= fx fy)
  23.          (+ fx
  24.         (/ (simplest-rational-internal
  25.             (/ (- y fy))
  26.             (/ (- x fx))))))
  27.  
  28.         (else
  29.          (+ 1 fx)))))
  30.   ;; do some juggling to satisfy preconditions
  31.   ;; of simplest-rational-internal.
  32.   (cond ((< y x)
  33.      (simplest-rational y x))
  34.     ((not (< x y))
  35.      (if (rational? x) x (slib:error)))
  36.     ((positive? x)
  37.      (simplest-rational-internal x y))
  38.     ((negative? y)
  39.      (- (simplest-rational-internal (- y)
  40.          (- x))))
  41.     (else
  42.      (if (and (exact? x) (exact? y))
  43.          0
  44.          0.0))))
  45.